<%
'######################################################################
'## ab.url.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Url Block
'## Version     :   v1.0.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2013/02/22 0:44
'## Description :   AspBox Url Block
'######################################################################

Class Cls_AB_URL

	Private s_prefix, s_suffix '用于短网址生成的混合KEY, 分别是：前缀 和 后缀
	Private s_by '用于短网址生成的指定算法

	Private Sub Class_Initialize()
		s_prefix = ""
		s_suffix = ""
		s_by = ""
	End Sub

	Private Sub Class_Terminate()

	End Sub

	'@ *****************************************************************************************
	'@ 属性值:  AB.Url.By [= s]  可读/写
	'@ 返  回:  String (字符串) "0" 或 "1"
	'@ 作  用:  设置/获取 用于短网址生成的指定算法
	'@  注：By值的默认值缺省为"0"（即采用java版或c#版算法）
	'==DESC=====================================================================================
	'@ 参数 s(可选): String (字符串) 用于短网址生成的指定算法，
	'@  值为 "", "0", "java", "c#", "csharp", "c" 这些值时，则算法By值自动转化为："0"
	'@  值为 "1", "php" 这些值时，则算法By值自动转化为："1"
	'==DEMO=====================================================================================
	'@ AB.Url.By = "java" '采用java版(或c#)
	'@ AB.C.Print AB.Url.By 'java版(或c#)对应的By值为"0"
	'@ *****************************************************************************************

	Public Property Get By()
		s_by = LCase(s_by)
		Select Case LCase(s_by)
			Case "","0","java","c#","csharp","c" : s_by = "0"
			Case "1","php" : s_by = "1"
			Case Else : s_by = "0"
		End Select
		By = s_by
	End Property

	Public Property Let By(byval s)
		If IsNull(s) Or trim(s)="" Then s = "0"
		Select Case LCase(Trim(s))
			Case "0","java","c#","csharp","c","" : s_by = "0"
			Case "1","php" : s_by = "1"
			Case Else : s_by = "0"
		End Select
	End Property

	'------------------------------------------------------------------------------------------
	'# AB.Url.Prefix 属性
	'# @syntax: AB.Url.Prefix
	'# @return: String (字符串) 获取设置的用于短网址生成的混合前缀
	'# @dowhat: 设置和获取用于短网址生成的混合前缀,默认值""
	'--DESC------------------------------------------------------------------------------------
	'# @param: 无参数
	'--DEMO------------------------------------------------------------------------------------
	'# AB.Url.Prefix = "Lajox"
	'------------------------------------------------------------------------------------------

	Public Property Let Prefix(ByVal p)
		s_prefix = p
	End Property
	Public Property Get Prefix()
		Prefix = s_prefix
	End Property

	'------------------------------------------------------------------------------------------
	'# AB.Url.Suffix 属性
	'# @syntax: AB.Url.Suffix
	'# @return: String (字符串) 获取设置的用于短网址生成的混合后缀
	'# @dowhat: 设置和获取用于短网址生成的混合后缀,默认值""
	'--DESC------------------------------------------------------------------------------------
	'# @param: 无参数
	'--DEMO------------------------------------------------------------------------------------
	'# AB.Url.Suffix = "Nasrick"
	'------------------------------------------------------------------------------------------

	Public Property Let Suffix(ByVal p)
		s_suffix = p
	End Property
	Public Property Get Suffix()
		Suffix = s_suffix
	End Property

	'@ ******************************************************************
	'@ 过程名:  AB.Url.Go url
	'@ 别  名:  AB.C.RR url
	'@ 返  回:  无返回值
	'@ 作  用:  URL定向跳转(Response.Redirect的缩写)
	'==DESC==============================================================
	'@ url : 跳转的地址 # [String]
	'==DEMO==============================================================
	'@ AB.Url.Go "http://www.baidu.com/" '等同于 Response.Redirect "http://www.baidu.com/"
	'@ ******************************************************************

	Public Sub Go(ByVal url)
		Response.Redirect(url)
	End Sub

	'@ ******************************************************************
	'@ 过程名:  AB.Url.JsGo url
	'@ 返  回:  无返回值
	'@ 作  用:  用JS实现的URL跳转
	'==DESC==============================================================
	'@ url : 跳转的地址 # [String]
	'==DEMO==============================================================
	'@ AB.Url.JsGo "http://www.baidu.com/" '相当于 <script>location.href='http://www.baidu.com/';</script>
	'@ AB.Url.JsGo(-1) '相当于 <script>history.go(-1);</script>
	'@ ******************************************************************

	Public Sub JsGo(ByVal url)
		Dim jscode : jscode = "location.href='" & url &"';"
		Dim temp : temp = LCase(Trim(url))
		If temp = "" Then jscode = "location.reload();"
		If temp = "-1" Or temp = "1" Or temp = "0" Then jscode = "history.go(" & Trim(url) &");"
		AB.C.Print "<scr"&"ipt type=""text/javascript"">" & jscode &"</scr"&"ipt>"
	End Sub

	'------------------------------------------------------------------------------------------
	'# AB.Url.ShortUrl 方法
	'# @syntax: arrUrl = AB.Url.ShortUrl(url)
	'# @return: Array (数组) 数组含有4个元素,各元素均包含6位串
	'# @dowhat: 实现短网址生成的算法
	'# 1.java版或c#版算法（此算法为缺省算法）
	'#   原理采用各大微博短网址(ShortUrl)的java版或c#版算法
	'#   返回值数组含有4个元素,各元素均包含6位串
	'# 2.php版算法
	'#   原理采用各大微博短网址(ShortUrl)的php版算法
	'#   返回值数组含有4个元素,各元素均包含6位串
	'#   思路：
	'#   a.将长网址md5生成32位签名串,分为4段, 每段8个字节;
	'#   b.对这四段循环处理, 取8个字节, 将他看成16进制串与0x3fffffff(30位1)与操作, 即超过30位的忽略处理;
	'#   c.这30位分成6段, 每5位的数字作为字母表的索引取得特定字符, 依次进行获得6位字符串;
	'#   d.总的md5串可以获得4个6位串; 取里面的任意一个就可作为这个长url的短url地址;
	'# 注：数组的4个元素包含6位串，取里面的任意一个就可作为这个长url的短url地址
	'# @author: Lajox (2012-06-14 9:25)
	'--DESC------------------------------------------------------------------------------------
	'# @param url: String (字符串) 原网址URL
	'--DEMO------------------------------------------------------------------------------------
	'# dim urls
	'# '_______(JAVA或C#版算法的实现)_______________
	'# ab.url.prefix = "Leejor" '设置用于短网址生成的混合前缀
	'# ab.url.suffix = "" '设置用于短网址生成的混合后缀
	'# ab.url.by = "java" '算法采用java或c#算法(by值缺省为java)
	'# urls = ab.url.shorturl("http://www.me3.cn")
	'# 'urls = ab.url.shorturl_java("http://www.me3.cn")
	'# ab.c.printcn urls(0) '得到值 fAVfui
	'# ab.c.printcn urls(1) '得到值 3ayQry
	'# ab.c.printcn urls(2) '得到值 UZzyUr
	'# ab.c.printcn urls(3) '得到值 36rQZn
	'# ab.trace urls
	'# '_______(php版算法的实现)_______________
	'# ab.url.prefix = "" '设置用于短网址生成的混合前缀
	'# ab.url.suffix = "" '设置用于短网址生成的混合后缀
	'# ab.url.by = "php" '指定算法采用php版算法
	'# urls = ab.url.shorturl("http://www.php100.com")
	'# 'urls = ab.url.shorturl_php("http://www.php100.com")
	'# ab.c.printcn urls(0) '得到值 cvch1h
	'# ab.c.printcn urls(1) '得到值 ssjfdx
	'# ab.c.printcn urls(2) '得到值 zzpkdh
	'# ab.c.printcn urls(3) '得到值 mbstyx
	'# ab.trace urls
	'------------------------------------------------------------------------------------------

	Public Function ShortUrl(Byval url)
		Dim Result
		s_by = LCase(Trim(Me.By))
		If s_by="" Or s_by="0" Or s_by="java" Or s_by="c#" Or s_by="csharp" Or s_by="c" Then
			Result = ShortUrl_Java(url)
		ElseIf s_by = "1" Or s_by = "php" Then
			Result = ShortUrl_PHP(url)
		Else
			Result = ShortUrl_Java(url)
		End If
		ShortUrl = Result
	End Function

	Public Function ShortUrl_Java(Byval url) 'java或c#版ShortUrl算法
		Dim chars, Hex, subHex, Result
		chars = Array("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z")
		AB.Use "E" : AB.E.Use "Md5"
		Hex = LCase(AB.E.Md5(s_prefix & url & s_suffix)) '32位Md5
		Result = Array()
		Dim hexint, index, out, i, j
		For i = 0 To 3
			subHex = Mid(Hex, (i * 8) + 1, 8)
			Dim temp : temp = Eval("&H" & subHex)
			hexint = &H3FFFFFFF And (1 * temp)
			out = ""
			For j = 0 To 5
				index = Cint(&H0000003D And hexint)
				out = out & chars(index)
				'hexint = hexint \ 2^5 '按位右移5位
				AB.Use "Char"
				hexint = AB.Char.RShift(hexint,5) '按位右移5位
			Next
			AB.Use "a"
			Result = AB.A.Push(Result, out)
		Next
		ShortUrl_Java = Result
	End Function

	Public Function ShortUrl_PHP(Byval url) 'php版ShortUrl算法
		Dim base32, Hex, hexLen, subHexLen, subHex, Result
		base32 = Array("a", "b", "c", "d", "e", "f", "g", "h","i", "j", "k", "l", "m", "n", "o", "p","q", "r", "s", "t", "u", "v", "w", "x","y", "z", "0", "1", "2", "3", "4", "5")
		AB.Use "E" : AB.E.Use "Md5"
		Hex = LCase(AB.E.Md5(s_prefix & url & s_suffix)) '32位Md5
		hexLen = Len(Hex)
		subHexLen = hexLen / 8
		Result = Array()
		Dim hexint, index, out, i, j
		For i = 0 To subHexLen-1
			subHex = Mid(Hex, (i * 8) + 1, 8)
			Dim temp : temp = Eval("&H" & subHex)
			hexint = &H3FFFFFFF And (1 * temp)
			out = ""
			For j = 0 To 5
				index = &H0000001F And hexint
				''AB.C.PrintCn(index & "<br>")
				out = out & base32(index)
				'hexint = hexint \ 2^5 '按位右移5位
				AB.Use "Char"
				hexint = AB.Char.RShift(hexint,5) '按位右移5位
			Next
			AB.Use "a"
			Result = AB.A.Push(Result, out)
		Next
		ShortUrl_PHP = Result
	End Function

End Class
%>